home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / thrdmrg.zip / RBBSSUB1.MRG < prev    next >
Text File  |  1988-10-28  |  7KB  |  186 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against RBBSSUB1.BAS to produce D:\LITE\RBBSSUB1.BAS
  3. * RBBSSUB1.BAS:  Date 10-2-1988  Size 52864 bytes
  4. * ------------[ Created 10-28-1988 18:47:18 ]------------
  5. * REPLACING old line(s) by new
  6. 59660 SUB PUTWORK (STRNG$,REC.NUM,REC.LEN) STATIC
  7.       ON ERROR GOTO 65000
  8.       FIELD #2,REC.LEN AS UPLOAD.RECORD$
  9.       LSET UPLOAD.RECORD$ = STRNG$
  10.       REC.NUM = REC.NUM + 1
  11.       PUT #2,REC.NUM
  12.       END SUB
  13. * ------[ first line different ]------
  14. '********************************************************************
  15. '  THREAD1            First message thread routine                  *
  16. '  THREAD2            Second message thread routine                 *
  17. '  THREAD3            Third message thread routine                  *
  18. '********************************************************************
  19. '===========================================================================
  20.  
  21.  
  22. ' $SUBTITLE: 'THREAD1 - create/update threaded message file'
  23. ' $PAGE
  24. '
  25. '  SUBROUTINE NAME    -- THREAD1
  26. '
  27. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  28. '                           HIGH.MESSAGE.NUMBER    This reply's message number
  29. '                           CURRENT.MESSAGE        Message number being replied
  30. '
  31. '  OUTPUT PARAMETERS  --     <<NONE>>
  32. '
  33. '  SUBROUTINE PURPOSE -- SUBROUTINE TO...
  34. '
  35.       SUB THREAD1 (HIGH.MESSAGE.NUMBER,CURRENT.MESSAGE,GRN$) STATIC
  36.         IF INSTR(GRN$," ") = 0 THEN   'PE102587
  37.          FILE.NAME$ = GRN$ + "T"  'PE102587
  38.         ELSE
  39.            FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T" 'PE102587
  40.       END IF
  41.       CURRENT.MESSAGE$ = STR$(CURRENT.MESSAGE)
  42.       HIGH.MESSAGE.NUMBER$ = STR$(HIGH.MESSAGE.NUMBER)
  43.       OPEN "R",9,FILE.NAME$,12
  44.       FIELD 9, 6 AS CM$, 6 AS HMN$
  45.       LSET CM$ = CURRENT.MESSAGE$
  46.       LSET HMN$ = HIGH.MESSAGE.NUMBER$
  47.       PUT #9,INT(LOF(9)/12)+1
  48.       CLOSE (9)
  49. * INSERTING new line(s)
  50. 59670 END SUB       ' THREAD1
  51. '
  52. ' $SUBTITLE: 'THREAD2 - a message was killed - check threaded message file'
  53. ' $PAGE
  54. '
  55. '  SUBROUTINE NAME    -- THREAD2
  56. '
  57. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  58. '                           MESSAGE.TO.KILL        Killed message's number
  59. '
  60. '  OUTPUT PARAMETERS  --     <<NONE>>
  61. '
  62. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
  63. '
  64.       SUB THREAD2 (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$) STATIC
  65.       IF INSTR(GRN$," ") = 0 THEN     'PE102587
  66.         FILE.NAME$ = GRN$ + "T"
  67.       ELSE
  68.         FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"
  69.       END IF
  70.       OPEN "R",9,FILE.NAME$,12
  71.       FIELD 9, 6 AS CM$, 6 AS HMN$
  72.        FOR I = 1 TO INT(LOF(9)/12)
  73.           GET 9,I
  74.           IF VAL(CM$) = MESSAGE.TO.KILL THEN     ' MARK THE RECORD
  75.              LSET CM$ = LEFT$(CM$,5) + "K"
  76.              PUT 9,I
  77.           ELSE 
  78.            IF VAL(HMN$) = MESSAGE.TO.KILL THEN     ' MARK THE RECORD
  79.               LSET HMN$ = LEFT$(HMN$,5) + "K"
  80.               LSET CM$ = LEFT$(CM$,5) + "K"
  81.              PUT 9,I
  82.           END IF
  83.        END IF
  84.       NEXT I
  85.       CLOSE (9)
  86. 59680 END SUB      ' THREAD2
  87. '
  88. ' $SUBTITLE: 'THREAD3 - a message was killed - check threaded message file'
  89. ' $PAGE
  90. '
  91. '  SUBROUTINE NAME    -- THREAD3
  92. '
  93. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  94. '                           CURRENT.MESSAGE        Message's number
  95. '
  96. '  OUTPUT PARAMETERS  --     <<NONE>>
  97. '
  98. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
  99. '
  100.       SUB THREAD3 (CURRENT.MESSAGE,GRN$) STATIC
  101.       IF INSTR(GRN$," ") = 0 THEN
  102.          FILE.NAME$ = GRN$ + "T"
  103.        ELSE
  104.          FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"
  105.       END IF
  106.        OPEN "R",9,FILE.NAME$,12 
  107.        FIELD 9, 6 AS CM$, 6 AS HMN$
  108.       AA$ = ""
  109.       ZZ$ = ""
  110.       FOR I = 1 TO INT(LOF(9)/12)
  111.           GET 9,I
  112.          IF RIGHT$(HMN$,1) = "K" THEN 59690
  113.          IF VAL(CM$) = CURRENT.MESSAGE AND RIGHT$(HMN$,1) <> "K" THEN 
  114.                 AA$ = AA$ + HMN$
  115.          END IF 
  116.           IF VAL(HMN$) = CURRENT.MESSAGE AND RIGHT$(CM$,1) = "K" THEN
  117.                 ZZ$ = LEFT$(CM$,5) + FG.1$+"(deleted) "+EMPHASIZE.OFF$
  118.          END IF
  119.           IF VAL(HMN$) = CURRENT.MESSAGE AND RIGHT$(CM$,1) <> "K" THEN 
  120.                 ZZ$ = CM$
  121.          END IF
  122. 59690 NEXT I
  123.        IF JUST.SEARCHING THEN 
  124.          CLOSE (9)
  125.           EXIT SUB
  126.        END IF
  127.       IF LEN(AA$) > 0 THEN 
  128. CALL QTPUT(FG.3$+"   Reply(ies) in message number(s): "+FG.4$ + AA$+EMPHASIZE.OFF$,1)
  129.       END IF
  130.       IF LEN(ZZ$) > 0 THEN 
  131. CALL QTPUT (FG.4$+"   This message is in reply to message " +FG.1$+ ZZ$+EMPHASIZE.OFF$,1)
  132.       END IF
  133. CALL QTPUT (FG.3$+ "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+EMPHASIZE.OFF$,1)
  134.       CLOSE (9)
  135. 59695 END SUB      ' THREAD3
  136. '
  137. ' $SUBTITLE: 'THREAD4 - UPDATE CONFR.DEF FILE FOR MESSAGE RECOVERY'
  138. ' $PAGE
  139. '
  140. '  SUBROUTINE NAME    -- THREAD4
  141. '
  142. '  INPUT PARAMETERS   --    PARAMETER            MEANING
  143. '
  144. '                           MESSAGE.TO.RECOVER   MESSAGE NUMBER BEING RECOVERED
  145. '                           FIRST.MESSAGE.RECORD NOT USED HERE BUT PASSED IN
  146. '                                                FROM RBBS CALL TO SUB2
  147. '                           ACTION.FLAG          PASSED FROM SUB2 NEEDED TO
  148. '                                                GIVE BACK TO RBBS MAIN CODE
  149. '                           GRN$                 CONFERENCE NAME
  150. '
  151. '  OUTPUT PARAMETERS  --      <<NONE>>
  152. '
  153. '  SUBROUTINE PURPOSE -- SUBROUTINE - UPDATE CONFR.DEF FILE AFTER MSG RECVRY
  154. '
  155.       SUB THREAD4 (MESSAGE.TO.RECOVER,FIRST.MESSAGES.RECORD,ACTION.FLAG,GRN$) STATIC
  156.       IF INSTR(GRN$," ") = 0 THEN
  157.          FILE.NAME$ = GRN$ + "T"
  158.       ELSE
  159.          FILE.NAME$ = LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"
  160.       END IF
  161.       OPEN "R",9,FILE.NAME$,12                           'WILL CREATE FILE IF NOT EXIST
  162.       FIELD 9, 6 AS CM$, 6 AS HMN$
  163.       FOR I = 1 TO INT(LOF(9)/12)
  164.           GET 9,I
  165.           IF VAL(CM$) = MESSAGE.TO.RECOVER THEN
  166.              LSET CM$ = LEFT$(CM$,5) + " "
  167.              PUT 9,I
  168.           ELSE
  169.               IF VAL(HMN$) = MESSAGE.TO.RECOVER THEN
  170.                  LSET HMN$ = LEFT$(HMN$,5) + " "
  171.                  LSET CM$ = LEFT$(CM$,5) + " "
  172.                  PUT 9,I
  173.               END IF
  174.           END IF
  175.       NEXT I
  176.       CLOSE (9)
  177. 59698 END SUB    'THREAD4
  178. '
  179. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  180. '  $PAGE
  181. '
  182. ' *****************************************************************************
  183. ' *  Error handling for the separately compiled subroutines of RBBS-PC        *
  184. ' *****************************************************************************
  185. '
  186.